TITLE RMAIL HACK FOR SAIL
	SUBTTL MRC 11/16/76

.INSRT MACROS

HEADBF:	BLOCK 50.			; MAIL HEADER BUFFER
MSGBFR:	BLOCK 4000.			; MESSAGE BUFFER

RMAIL:	JFCL				; CCL ENTRY
	RESET				; RESET ALL I/O
	GETPPN				; GET MY PPN
	 JFCL				; SILLY SKIP
	HRRZM MAIBOX			; SAVE MAILBOX NAME
	OPEN [0 ? 'DSK,, ? INPBF]	; GET DSK INPUT CHANNEL
	 JRST 4,.-1			; NO DSK CHANNELS?
	OPEN 1,[0 ? 'DSK,, ? OUTBF,,]	; GET DSK OUTPUT CHANNEL
	 JRST 4,.-1			; NO DSK CHANNELS?
	OPEN 2,[200 ? 'TTY,, ? 0]	; TURN OFF TTY ECHOING
	 JRST 4,.-1			; TTY OPEN FAILURE?
	LOOKUP MAIBOX			; NEW MAIL IN MY MAILBOX?
	 JRST PERUSE			; NO, JUST PERUSE OLD MAIL
	OUTSTR [ASCIZ/You have new mail!
/]
	ENTER 1,[SIXBIT/RMAIL TMP/ ? 0 ? 0]; CREATE A TEMP FILE
	 JRST 4,.-1			; CAN'T CREATE TMP FILE?
ETVFLS:	JSR INPCHR			; GET A CHARACTER
	 JRST 4,.-1			; NOT AN ETV FILE?
	CAXE 0,↑L			; END OF ETV DIRECTORY?
	 JRST ETVFLS			; NOT YET
CPYNEW:	JSR INPCHR			; GET A CHARACTER
	 JRST CPYOLD			; ALL DONE
	JSR PUTCHR			; SHOVE IT IN FILE
	JRST CPYNEW			; LOOP FOR MORE
CPYOLD:	RENAME DELBLK			; DELETE MAIL FILE
	 JRST 4,.-1			; DELETE FAILED?
	RELEASE				; FREE UP CHANNEL
	OPEN [0 ? 'DSK,, ? INPBF]	; OPEN UP CHANNEL
	 JRST 4,.-1			; OPEN FAILURE?
	LOOKUP OLDBLK			; FIND OLD RMAIL FILE
	 JRST RNAME			; NONE, JUST RENAME
CPYOL1:	JSR INPCHR			; GET CHARACTER
	 JRST DELOLD			; DONE, DELETE OLD FILE
	JSR PUTCHR			; STORE CHARACTER
	JRST CPYOL1			; AND LOOP FOR MORE
DELOLD:	RENAME DELBLK			; PFFT GOES THIS FILE!
	 JRST 4,.-1			; DELETE ERROR?
RNAME:	RENAME 1,NEWBLK			; AND SHOW UPDATED FILE
	 JRST 4,.-1			; RENAME FAILURE?
PERUSE:	RELEASE				; FREE UP READ
	RELEASE 1,			; FREE UP WRITE
	OPEN [0 ? 'DSK,, ? INPBF]	; OPEN INPUT FILE
	 JRST 4,.-1			; OPEN FAILED???
	OPEN 1,[0 ? 'DSK,, ? OUTBF,,]	; OPEN OUTPUT FILE
	 JRST 4,.-1			; OPEN FAILED?
	LOOKUP REDBLK			; OPEN INPUT SIDE
	 EXIT				; FNF, EXIT
	ENTER 1,WRTBLK			; OPEN OUTPUT SIDE
	 JRST 4,.-1			; CAN'T OVERWRITE FILE?
	JSR INPCHR			; GET A CHARACTER
	 EXIT				; EMPTY FILE...
	CAXE 0,↑O			; HIT A ↑O FOR A MSG?
	 JRST 4,.-1			; CRUFT???
GETHED:	MOVE 1,[POINT. 7,HEADBF]	; LOAD BUFFER POINTER
	STORE %ZEROS,HEADBF,HEADBF+49.	; CLEAR HEADER BUFFER
GETHD1:	JSR INPCHR			; GET A CHARACTER
	 JRST QUIT			; NONE TO GET, QUIT
	IDPB 1				; SAVE CHAR IN BUFFER
	CAXE 0,↑J			; HIT LF YET?
	 JRST GETHD1			; NOT YET
	OUTSTR HEADBF			; OUTPUT HEADER BUFFER
	STORE %ZEROS,MSGBFR,MSGBFR+3999.; CLEAR MESSAGE BUFFER
	MOVE 1,[POINT. 7,MSGBFR]	; LOAD POINTER TO MESSAGE BUFFER
GETMSG:	JSR INPCHR			; GET A CHARACTER
	 JRST GOTMSG			; NONE TO GET, GOT IT
	CAXN 0,↑L			; FORM FEED?
	 JRST GETMSG			; YES, FLUSH IT
	CAXN 0,↑O			; START OF A NEW MESSAGE?
	 JRST GOTMSG			; YES, START DISPLAY
	IDPB 1				; SAVE IN BUFFER
	JRST GETMSG			; AND LOOP FOR MORE
GOTMSG:	SKIPE MSGBFR			; ANY MESSAGE?
	 OUTSTR [ASCIZ/--More--/]
CMND:	INCHRW				; GET A COMMAND
	CAXLE 0,<"←>			; LOWER CASE?
	 TXZ 0,<" >			; YES, MAKE UPPER CASE
	CAXN 0,<" >			; PRINT MORE?
	 JRST [	OUTSTR [ASCIZ/
/]
		OUTSTR MSGBFR		; YES, PRINT MORE
		JRST CMND]		; AND GET A COMMAND
	CAXN 0,"D			; DELETE?
	 JRST [	OUTSTR [ASCIZ/
/]
		JRST GETHED]		; GO TO NEXT MESSAGE
	CAXN 0,"N			; NEXT MESSAGE
	 JRST [	OUTSTR [ASCIZ/
/]
		JSR WRTMSG		; WRITE MESSAGE
		JRST GETHED]		; AND GET NEXT ONE
	CAXN 0,"?			; GIVE HELP?
	 JRST [	OUTSTR [ASCIZ/Options:
<space>	Type body of message
D	Delete this message from RMAIL.TXT file
N	Go to next message, preserving this one
X	Exit, implied by D or N on last message
?	Type this cruft
/]
		JRST CMND]		; END OF CRUFT
	CAXE 0,"X			; EXIT?
	 JRST [	CLRBFI			; NO, FLUSH INPUT
		OUTSTR [ASCIZ/Bad -- "?" for help
/]					; ERROR MESSAGE
		JRST CMND]		; AND GET A COMMAND AGAIN
	JSR WRTMSG			; WRITE OUT MESSAGE
	JSR INPCHR			; GET A CHARACTER
	 JRST QUIT			; NONE TO GET, QUIT
	MOVE 1,				; SAVE IT
	MOVX 0,↑O			; LOAD UP A ↑O
	JSR PUTCHR			; AND OUTPUT IT
	MOVE 1				; GET CHARACTER BACK
	JSR PUTCHR			; OUTPUT IT
	JSR INPCHR			; GET ANOTHER CHARACTER
	 TXNA				; ALL DONE
	  JRST .-3			; NO, LOOP FOR MORE
QUIT:	CLOSE 1,			; CLOSE OFF FILE
	EXIT				; AND EXIT

WRTMSG:	0				; RETURN PC
	MOVX 0,↑O			; GET A ↑O
	JSR PUTCHR			; AND OUTPUT IT
IRPS BFR,,[HEADBF MSGBFR]
	 MOVE 1,[POINT. 7,BFR]		; LOAD BUFFER POINTER
	 ILDB 1				; GET A CHARACTER
	 JUMPN [JSR PUTCHR		; SAVE IT IF NON-NULL
		JRST .-1]		; AND LOOP FOR MORE
TERMIN
	JRST 2,@WRTMSG			; AND RETURN

INPCHR:	0				; RETURN PC
	SOSG INPBF+2			; BUFFER READY?
	 IN				; NO, GET SOMETHING
	  TXNA				; WON
	   JRST 2,@INPCHR		; LOST, RETURN NON-SKIP
	ILDB INPBF+1			; GET A CHARACTER
	JUMPE INPCHR+1			; FLUSH NULLS
	AOS INPCHR			; BUMP RETURN PC
	JRST 2,@INPCHR			; AND RETURN

PUTCHR:	0				; RETURN PC
	SOSG OUTBF+2			; BUFFER FULL?
	 OUT 1,				; YES, SLAM IT OUT
	  TXNA				; WON
	   JRST 4,.-1			; LOST
	IDPB OUTBF+1			; SAVE CHARACTER
	JRST 2,@PUTCHR			; AND SAVE CHARACTER

MAIBOX:	0				; FN1
	'MSG,,				; FN2
	0				; DATE CRUFT
	SIXBIT/  2  2/			; PPN

IRPS TYP,,[OLD NEW RED WRT]
 TYP!BLK: SIXBIT/RMAIL TXT/ ? 0 ? 0	; RMAIL FILE LOOKUP BLOCK
TERMIN

DELBLK:	REPEAT 4,[0 ?]			; FILE DELETE BLOCK

INPBF:	BLOCK 3				; INPUT BUFFER HEADER
OUTBF:	BLOCK 3				; OUTPUT BUFFER HEADER

	END RMAIL